home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 18 / forthsup / filedate.fth < prev    next >
Encoding:
Text File  |  1986-09-18  |  1.2 KB  |  45 lines
  1. \ Get/Set the date and time on a file
  2.  
  3. only forth system also forth hidden also forth definitions
  4.  
  5. create datebuf 2 /w* allot
  6.  
  7. : >buf  ( s m h  d m y  -- )
  8.    dmy> datebuf wa1+ w!  hms> datebuf w!
  9. ;
  10. : buf>  ( -- s m h  d m y )
  11.    datebuf w@ >hms  datebuf wa1+ w@ >dmy
  12. ;
  13. : set-date&time  ( sec min hour  day mon year  filename -- )
  14.    >r >buf r>
  15.    0 swap  f_open dup 0< abort" Can't open file"  ( handle )
  16.    1  over  datebuf f_datime  ( handle )
  17.    f_close drop
  18. ;
  19. : get-date&time  ( filename -- sec min hour  day mon year )
  20.    0 swap  f_open dup 0< abort" Can't open file"  ( handle )
  21.    0  over  datebuf f_datime  ( handle )
  22.    f_close drop
  23.    buf>
  24. ;
  25. : touch-all ( -- )    \ Set the date and time on all files to right now
  26.    [""] *.*  file-pattern
  27.    begin another-file?
  28.    while    now today  filename set-date&time
  29.    repeat
  30. ;
  31. : (date  ( pattern -- )
  32.    file-pattern 
  33.    begin another-file? 
  34.    while  filename  ".
  35.           filename  get-date&time    ( s m h  d m y )
  36.           td 14 to-column  .date     ( s m h )
  37.       td 40 to-column  .time  cr
  38.           exit?  if exit then
  39.    repeat 
  40. ; 
  41. : date  \ pattern  ( -- )
  42.    get-filename (date
  43. ; 
  44. only forth also definitions
  45.